home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / utils / ted / tededit.pas < prev    next >
Pascal/Delphi Source File  |  1994-10-02  |  11KB  |  366 lines
  1. PROGRAM TED_EDITOR;
  2. USES CRT,DOS;
  3.  
  4. CONST
  5.  HEADER  : ARRAY [1..20] OF BYTE =(254,84,69,68,254,57,52,254,80,65,
  6.                                    82,65,68,105,83,69,254,00,00,07);
  7. VAR
  8.  FONT           : ARRAY [0..255,0..15] OF BYTE;
  9.  PALETTE,TMPP   : ARRAY [0..255,1..3] OF BYTE;
  10.  CHARS          : ARRAY [' '..']'] OF POINTER;
  11.  CHARSDATA      : ARRAY [' '..']',1..3] OF BYTE;
  12.  F              : FILE;
  13.  B              : BYTE;
  14.  X,Y,I          : INTEGER;
  15.  CH,K           : CHAR;
  16.  ZOOMER         : BYTE;
  17.  WSPX,WSPY      : INTEGER;
  18.  EXT,LIGHT      : BOOLEAN;
  19.  COLOR          : BYTE;
  20.  NAME           : STRING;
  21.  
  22. {───────────────────────────────────────────────────────────────────────────}
  23. PROCEDURE INITVGA; ASSEMBLER; { INITIALIZE VGA CARD MODE 13H }
  24. ASM
  25.  MOV AX,0013H
  26.  INT 10H
  27. END;
  28. {───────────────────────────────────────────────────────────────────────────}
  29. PROCEDURE CLOSEVGA; ASSEMBLER; { CLOSE VGA MODE AND SET TEXT }
  30. ASM
  31.  MOV AX,0003H
  32.  INT 10H
  33. END;
  34. {───────────────────────────────────────────────────────────────────────────}
  35. PROCEDURE SETCOLOR(NR,R,G,B: BYTE); ASSEMBLER; { SET RGB VAL TO COLOR NR }
  36. ASM
  37.  MOV DX,3C8H
  38.  MOV AL,NR
  39.  OUT DX,AL
  40.  INC DX
  41.  MOV AL,R
  42.  OUT DX,AL
  43.  MOV AL,G
  44.  OUT DX,AL
  45.  MOV AL,B
  46.  OUT DX,AL
  47. END;
  48. {───────────────────────────────────────────────────────────────────────────}
  49. PROCEDURE PUTPIX(X,Y : INTEGER; C: BYTE); ASSEMBLER; { PLOT PIXEL AT (X,Y) }
  50. ASM
  51.  MOV   AX, 0A000H
  52.  MOV   ES, AX
  53.  MOV   AX, 320
  54.  MUL   Y
  55.  ADD   AX, X
  56.  MOV   DI, AX
  57.  MOV   AL, C
  58.  STOSB
  59. END;
  60. {───────────────────────────────────────────────────────────────────────────}
  61. FUNCTION GETPIX(X,Y : INTEGER): BYTE; ASSEMBLER; { GET A PIXEL FROM (X,Y) }
  62. ASM
  63.  MOV   AX, 0A000H
  64.  MOV   ES, AX
  65.  MOV   AX, 320
  66.  MUL   Y
  67.  ADD   AX, X
  68.  MOV   DI, AX
  69.  LODSB
  70. END;
  71. {───────────────────────────────────────────────────────────────────────────}
  72. PROCEDURE RECTANGLE(X1,Y1,X2,Y2: INTEGER; C: BYTE); { DRAW A RECTANGLE }
  73. VAR Z: INTEGER;
  74. BEGIN
  75.  FOR Z:=X1 TO X2 DO
  76.  BEGIN
  77.   PUTPIX(Z,Y1,C);
  78.   PUTPIX(Z,Y2,C);
  79.  END;
  80.  FOR Z:=Y1 TO Y2 DO
  81.  BEGIN
  82.   PUTPIX(X1,Z,C);
  83.   PUTPIX(X2,Z,C);
  84.  END;
  85. END;
  86. {───────────────────────────────────────────────────────────────────────────}
  87. PROCEDURE RECTANGLE2(X1,Y1,X2,Y2: INTEGER; C: BYTE); { DRAW A RECTANGLE #2 }
  88. VAR Z: INTEGER;
  89. BEGIN
  90.  FOR Z:=X1 TO X2 DO
  91.  IF ODD(Z) THEN BEGIN
  92.   PUTPIX(Z,Y1,C);
  93.   PUTPIX(Z,Y2,C);
  94.  END;
  95.  FOR Z:=Y1 TO Y2 DO
  96.  IF ODD(Z) THEN BEGIN
  97.   PUTPIX(X1,Z,C);
  98.   PUTPIX(X2,Z,C);
  99.  END;
  100. END;
  101. {───────────────────────────────────────────────────────────────────────────}
  102. PROCEDURE BAR(X1,Y1,X2,Y2: INTEGER; C: BYTE); { DRAW A FILLED BAR }
  103. VAR X,Y: INTEGER;
  104. BEGIN
  105.  FOR Y:=Y1 TO Y2 DO
  106.  FOR X:=X1 TO X2 DO
  107.  PUTPIX(X,Y,C);
  108. END;
  109. {───────────────────────────────────────────────────────────────────────────}
  110. PROCEDURE ROMFONT;
  111. VAR F8X8OFS,F8X8SEG: WORD;
  112. BEGIN
  113.  ASM
  114.   PUSH BP
  115.   MOV  AH,11H
  116.   MOV  AL,30H
  117.   MOV  BH,06H
  118.   INT  10H
  119.   MOV  AX,BP
  120.   POP  BP
  121.   MOV  F8X8OFS,AX
  122.   MOV  F8X8SEG,ES
  123.  END;
  124.  MOVE(MEM[F8X8SEG:F8X8OFS],FONT,256*16)
  125. END;
  126. {───────────────────────────────────────────────────────────────────────────}
  127. PROCEDURE WRITEXY(TEKST: STRING; X,Y: INTEGER; C: BYTE); { PRINT TEXT AT X,Y }
  128. VAR TX,TY: WORD; IZ: BYTE;
  129. BEGIN
  130.  FOR IZ:=1 TO LENGTH(TEKST) DO
  131.  FOR TY:=0 TO 15 DO
  132.  FOR TX:=0 TO 7 DO
  133.   IF FONT[ORD(TEKST[IZ]),TY] AND ($80 SHR TX)<>0 THEN
  134.   PUTPIX(X+TX+(IZ-1)*10,Y+TY,C);
  135. END;
  136. {───────────────────────────────────────────────────────────────────────────}
  137. PROCEDURE LOADPAL(NAME: STRING); { LOAD .PAL FILE AND SET PALETTE }
  138. BEGIN
  139.  ASSIGN(F,NAME+'.PAL');
  140.  RESET(F,1);
  141.  BLOCKREAD(F,PALETTE,768);
  142.  CLOSE(F);
  143.  FOR B:=0 TO 255 DO SETCOLOR(B,PALETTE[B,1],PALETTE[B,2],PALETTE[B,3]);
  144. END;
  145. {───────────────────────────────────────────────────────────────────────────}
  146. PROCEDURE LOADTED(NAME: STRING); { LOAD .TED FILE TO MEMORY }
  147. VAR TX,TY: BYTE; CH: CHAR;
  148. BEGIN
  149.  ASSIGN(F,NAME+'.TED');
  150.  RESET(F,1);
  151.  SEEK(F,20);
  152.  WHILE NOT(EOF(F)) DO
  153.  BEGIN
  154.   BLOCKREAD(F,CH,1);
  155.   BLOCKREAD(F,TX,1);
  156.   BLOCKREAD(F,TY,1);
  157.   GETMEM(CHARS[CH],TX*TY);
  158.   CHARSDATA[CH,1]:=TX; CHARSDATA[CH,2]:=TY; CHARSDATA[CH,3]:=1;
  159.   BLOCKREAD(F,CHARS[CH]^,TX*TY);
  160.  END;
  161.  CLOSE(F);
  162. END;
  163. {───────────────────────────────────────────────────────────────────────────}
  164. PROCEDURE DONETED; { DEALLOCATE FONT MEMORY }
  165. VAR CH: CHAR;
  166. BEGIN
  167.  FOR CH:=' ' TO ']' DO
  168.  BEGIN
  169.   IF CHARSDATA[CH,3]=1 THEN
  170.   BEGIN
  171.    FREEMEM(CHARS[CH],CHARSDATA[CH,1]*CHARSDATA[CH,2]);
  172.    CHARSDATA[CH,3]:=0;
  173.   END;
  174.  END;
  175. END;
  176. {───────────────────────────────────────────────────────────────────────────}
  177. PROCEDURE BIGCHAR(X,Y: INTEGER; CH: CHAR; ZOOM: BYTE);
  178. VAR AX,AY: INTEGER;
  179. BEGIN
  180.  IF CHARSDATA[CH,3]<>1 THEN EXIT;
  181.  FOR AY:=0 TO CHARSDATA[CH,2]-1 DO
  182.  FOR AX:=0 TO CHARSDATA[CH,1]-1 DO
  183.  BEGIN
  184.   BAR(X+AX*ZOOM,Y+AY*ZOOM,X+AX*ZOOM+ZOOM,Y+AY*ZOOM+ZOOM,MEM[SEG(CHARS[CH]^):OFS(CHARS[CH]^)+AY*CHARSDATA[CH,1]+AX]);
  185.  END;
  186. END;
  187. {───────────────────────────────────────────────────────────────────────────}
  188. PROCEDURE SAVECHARSET(NAME: STRING); { SAVE EDITED FONTS }
  189. VAR F: FILE; CH: CHAR;
  190. BEGIN
  191.  ASSIGN(F,NAME+'.TED');
  192.  REWRITE(F,1);
  193.  BLOCKWRITE(F,HEADER,20);
  194.  FOR CH:=' ' TO ']' DO
  195.  BEGIN
  196.   IF CHARSDATA[CH,3]>0 THEN
  197.   BEGIN
  198.    BLOCKWRITE(F,CH,1);
  199.    BLOCKWRITE(F,CHARSDATA[CH,1],1);
  200.    BLOCKWRITE(F,CHARSDATA[CH,2],1);
  201.    BLOCKWRITE(F,CHARS[CH]^,CHARSDATA[CH,1]*CHARSDATA[CH,2]);
  202.   END;
  203.  END;
  204.  CLOSE(F);
  205. END;
  206. {───────────────────────────────────────────────────────────────────────────}
  207. PROCEDURE CHARDOWN(CH: CHAR);
  208. VAR LN: ARRAY[1..100] OF BYTE; Y: INTEGER;
  209. BEGIN
  210.  MOVE(MEM[SEG(CHARS[CH]^):OFS(CHARS[CH]^)+(CHARSDATA[CH,2]-1)*CHARSDATA[CH,1]],LN,CHARSDATA[CH,1]);
  211.  FOR Y:=CHARSDATA[CH,2] DOWNTO 1 DO
  212.  MOVE(MEM[SEG(CHARS[CH]^):OFS(CHARS[CH]^)+(Y-2)*CHARSDATA[CH,1]],
  213.       MEM[SEG(CHARS[CH]^):OFS(CHARS[CH]^)+(Y-1)*CHARSDATA[CH,1]],CHARSDATA[CH,1]);
  214.  MOVE(LN,MEM[SEG(CHARS[CH]^):OFS(CHARS[CH]^)],CHARSDATA[CH,1]);
  215. END;
  216. {───────────────────────────────────────────────────────────────────────────}
  217. PROCEDURE CHARUP(CH: CHAR);
  218. VAR LN: ARRAY[1..100] OF BYTE; Y: INTEGER;
  219. BEGIN
  220.  MOVE(MEM[SEG(CHARS[CH]^):OFS(CHARS[CH]^)],LN,CHARSDATA[CH,1]);
  221.  FOR Y:=1 TO CHARSDATA[CH,2]-1 DO
  222.  MOVE(MEM[SEG(CHARS[CH]^):OFS(CHARS[CH]^)+(Y)*CHARSDATA[CH,1]],
  223.       MEM[SEG(CHARS[CH]^):OFS(CHARS[CH]^)+(Y-1)*CHARSDATA[CH,1]],CHARSDATA[CH,1]);
  224.  MOVE(LN,MEM[SEG(CHARS[CH]^):OFS(CHARS[CH]^)+(CHARSDATA[CH,2]-1)*CHARSDATA[CH,1]],CHARSDATA[CH,1]);
  225. END;
  226. {───────────────────────────────────────────────────────────────────────────}
  227. PROCEDURE CHARLEFT(CH: CHAR);
  228. VAR LN: ARRAY[1..100] OF BYTE; Y: INTEGER;
  229. BEGIN
  230.  FOR Y:=1 TO CHARSDATA[CH,2] DO LN[Y]:=MEM[SEG(CHARS[CH]^):OFS(CHARS[CH]^)+(Y-1)*CHARSDATA[CH,1]];
  231.  FOR Y:=1 TO CHARSDATA[CH,2] DO
  232.  MOVE(MEM[SEG(CHARS[CH]^):OFS(CHARS[CH]^)+(Y-1)*CHARSDATA[CH,1]+1],
  233.       MEM[SEG(CHARS[CH]^):OFS(CHARS[CH]^)+(Y-1)*CHARSDATA[CH,1]],CHARSDATA[CH,1]-1);
  234.  FOR Y:=1 TO CHARSDATA[CH,2] DO MEM[SEG(CHARS[CH]^):OFS(CHARS[CH]^)+(Y-1)*CHARSDATA[CH,1]+CHARSDATA[CH,1]-1]:=LN[Y];
  235. END;
  236. {───────────────────────────────────────────────────────────────────────────}
  237. PROCEDURE CHARRIGHT(CH: CHAR); { DONT WORK, NOW!!! }
  238. VAR LN: ARRAY[1..100] OF BYTE; Y: INTEGER;
  239. BEGIN
  240.  FOR Y:=1 TO CHARSDATA[CH,2] DO LN[Y]:=MEM[SEG(CHARS[CH]^):OFS(CHARS[CH]^)+(Y-1)*CHARSDATA[CH,1]+CHARSDATA[CH,1]-1];
  241.  FOR Y:=1 TO CHARSDATA[CH,2] DO
  242.  MOVE(MEM[SEG(CHARS[CH]^):OFS(CHARS[CH]^)+(Y-1)*CHARSDATA[CH,1]],
  243.       MEM[SEG(CHARS[CH]^):OFS(CHARS[CH]^)+(Y-1)*CHARSDATA[CH,1]+1],CHARSDATA[CH,1]-1);
  244.  FOR Y:=1 TO CHARSDATA[CH,2] DO MEM[SEG(CHARS[CH]^):OFS(CHARS[CH]^)+(Y-1)*CHARSDATA[CH,1]]:=LN[Y];
  245. END;
  246. {───────────────────────────────────────────────────────────────────────────}
  247. PROCEDURE SETFPAL;
  248. VAR B: BYTE;
  249. BEGIN
  250.  FOR B:=0 TO 255 DO SETCOLOR(B,PALETTE[B,1],PALETTE[B,2],PALETTE[B,3]);
  251. END;
  252. {───────────────────────────────────────────────────────────────────────────}
  253. PROCEDURE LIGHTON;
  254. BEGIN
  255.  LIGHT:=TRUE;
  256.  MOVE(PALETTE,TMPP,768);
  257.  FILLCHAR(PALETTE,768,255);
  258.  FILLCHAR(PALETTE,3,0);
  259.  SETFPAL;
  260.  SETCOLOR(255,255,0,0);
  261. END;
  262. {───────────────────────────────────────────────────────────────────────────}
  263. PROCEDURE LIGHTOFF;
  264. BEGIN
  265.  LIGHT:=FALSE;
  266.  MOVE(TMPP,PALETTE,768);
  267.  SETFPAL;
  268.  SETCOLOR(255,255,255,255);
  269. END;
  270. {───────────────────────────────────────────────────────────────────────────}
  271.  
  272.  
  273.  
  274.  
  275.  
  276.  
  277. BEGIN
  278.  CLRSCR;
  279.  WRITELN;
  280.  WRITELN('■ TED FONT FILE EDITOR - CORRECTOR  (c) 94 PARADiSE ');
  281.  WRITELN;
  282.  IF PARAMCOUNT=0 THEN
  283.  BEGIN
  284.   WRITELN('■ USAGE: TEDEDIT.EXE <FONTNAME> ');
  285.   WRITELN('■ EXAMPLE: TEDEDIT FONT001 ');
  286.   WRITELN;
  287.   HALT;
  288.  END;
  289.  WRITELN('■ HOT KEYS: ESC - EXIT           PGUP/PGDN - NEXT/PREV CHAR ');
  290.  WRITELN('            HOME - SELECT CHAR   F1/F2 - NEXT/PREV COLOR');
  291.  WRITELN('            F3/F4 - NEXT/PREV 10 COLORS ');
  292.  WRITELN('            INSERT/DEC - PUT/ERASE COLOR');
  293.  WRITELN('            F5/F6 - SCROLL UP/DN F7/F8 - SCROLL LEFT/RIGHT');
  294.  WRITELN('            F9 - LIGHT COLORS');
  295.  WRITELN;
  296.  WRITELN('■ PRESS ANY KEY TO EDIT FILE "',PARAMSTR(1),'.TED" ...');
  297.  WRITELN;
  298.  READKEY;
  299.  NAME:=PARAMSTR(1);
  300.  INITVGA;
  301.  ROMFONT;
  302.  LOADPAL(NAME);
  303.  LOADTED(NAME);
  304.  SETCOLOR(255,255,255,255);
  305.  WRITEXY('FONT EDIT-CORRECT  (C) PARADiSE',0,0,255);
  306.  K:='A';
  307.  COLOR:=1;
  308.  ZOOMER:=3;
  309.  RECTANGLE(9,39,11+CHARSDATA[CH,1]*ZOOMER,41+CHARSDATA[CH,2]*ZOOMER,255);
  310.  BIGCHAR(10,40,CH,ZOOMER);
  311.  WSPX:=1; WSPY:=1;
  312.  EXT:=FALSE;
  313.  LIGHT:=FALSE;
  314.  IF (CHARSDATA[K,3]=1) THEN
  315.  BEGIN
  316.   RECTANGLE(9,39,11+CHARSDATA[K,1]*ZOOMER,41+CHARSDATA[K,2]*ZOOMER,255);
  317.   BIGCHAR(10,40,K,ZOOMER);
  318.  END;
  319.  RECTANGLE2(10+(WSPX-1)*ZOOMER,40+(WSPY-1)*ZOOMER,10+WSPX*ZOOMER,40+WSPY*ZOOMER,255);
  320.  REPEAT
  321.   CH:=READKEY;
  322.   IF CH=#0 THEN
  323.   BEGIN
  324.    EXT:=TRUE;
  325.    CH:=READKEY;
  326.   END;
  327.   IF CH='+' THEN INC(ZOOMER);
  328.   IF CH='-' THEN DEC(ZOOMER);
  329.   IF EXT THEN
  330.   BEGIN
  331.   CASE ORD(CH) OF
  332.    73: K:=CHR(ORD(K)-1);
  333.    81: K:=CHR(ORD(K)+1);
  334.    71: K:=UPCASE(READKEY);
  335.    82: MEM[SEG(CHARS[K]^):OFS(CHARS[K]^)+(WSPY-1)*CHARSDATA[K,1]+WSPX-1]:=COLOR;
  336.    83: MEM[SEG(CHARS[K]^):OFS(CHARS[K]^)+(WSPY-1)*CHARSDATA[K,1]+WSPX-1]:=0;
  337.    31: BEGIN SAVECHARSET(NAME); SOUND(10000); DELAY(100); NOSOUND; END;
  338.    59: DEC(COLOR);
  339.    60: INC(COLOR);
  340.    61: DEC(COLOR,10);
  341.    62: INC(COLOR,10);
  342.    63: CHARUP(K);
  343.    64: CHARDOWN(K);
  344.    65: CHARLEFT(K);
  345.    66: CHARRIGHT(K);
  346.    67: IF LIGHT THEN LIGHTOFF ELSE LIGHTON;
  347.   END;
  348.   CASE LO(ORD(CH)) OF
  349.    72: IF WSPY>1 THEN DEC(WSPY);
  350.    80: IF WSPY<CHARSDATA[CH,2] THEN INC(WSPY);
  351.    75: IF WSPX>1 THEN DEC(WSPX);
  352.    77: IF WSPX<CHARSDATA[CH,1] THEN INC(WSPX);
  353.   END;
  354.   EXT:=FALSE;
  355.   END;
  356.   IF (CHARSDATA[K,3]=1) THEN
  357.   BEGIN
  358.    RECTANGLE(9,39,11+CHARSDATA[K,1]*ZOOMER,41+CHARSDATA[K,2]*ZOOMER,255);
  359.    BIGCHAR(10,40,K,ZOOMER);
  360.   END;
  361.   RECTANGLE2(10+(WSPX-1)*ZOOMER,40+(WSPY-1)*ZOOMER,10+WSPX*ZOOMER,40+WSPY*ZOOMER,255);
  362.  UNTIL (CH=#27); { ESC }
  363.  
  364.  DONETED;
  365.  CLOSEVGA;
  366. END.